home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbapg.arc / TRIG.PRG < prev    next >
Encoding:
Text File  |  1984-08-12  |  4.3 KB  |  161 lines

  1. * Program.: TRIG.PRG
  2. * Author..: Alastair Dallas
  3. * Date....: 07/03/84
  4. * Notice..: Copyright 1984, Ashton-Tate, All Rights Reserved
  5. * Version.: dBASE III, version 1.0
  6. * Notes...: Transcendental functions for dBASE III.  
  7. *
  8. * Assumes: SET DECIMALS TO 12
  9. *          SET FIXED ON
  10. *
  11. PROCEDURE PI  { The value of PI to 15 places. }
  12. PARAMETER value
  13.    value = 3.14159265358979
  14. RETURN
  15. *
  16. *
  17. PROCEDURE Makdeg  { Convert radians to degrees. }
  18. PARAMETER value
  19.    value = value * (180/3.14159265358979)
  20. RETURN
  21. *
  22. *
  23. PROCEDURE Makrad  { Convert degrees to radians. }
  24. PARAMETER value
  25.    value = value * (3.14159265358979/180)
  26. RETURN
  27. *
  28. *
  29. PROCEDURE Sine  { Sine function } 
  30. PARAMETER argument
  31.    * --- IN:  argument in radians
  32.    * ---OUT:  argument = SINE( argument )
  33.    DO Tan_half WITH argument
  34.    argument = (argument + argument) / (argument * argument + 1.0)
  35. RETURN
  36. *
  37. *
  38. PROCEDURE Cosine  { Cosine function }
  39. PARAMETER argument
  40.    * --- IN:  argument in radians
  41.    * ---OUT:  argument = COS( argument )
  42.    DO Tan_half WITH argument
  43.    argument = argument * argument
  44.    argument = (1.0 - argument) / (1.0 + argument)
  45. RETURN
  46. *
  47. *
  48. PROCEDURE Tangent  { Tangent function }
  49. PARAMETER argument
  50.    * --- IN:  argument in radians
  51.    * ---OUT:  argument = TAN( argument )
  52.    DO Tan_half WITH argument
  53.    argument = (argument + argument) / (1.0 - argument * argument) 
  54. RETURN
  55. *
  56. *
  57. PROCEDURE Arcsin  { Arcsin function }
  58. PARAMETER argument
  59.    *  IN:  argument = ratio of sides
  60.    * OUT:  argument = ARCSIN( argument )
  61.    value0 = argument
  62.    value1 = 1
  63.    DO CASE
  64.       CASE value0 < 0.0
  65.          value0 = -(value0)
  66.          value1 = -1
  67.       CASE value0 = 0
  68.          value1 = 0
  69.    ENDCASE
  70.    DO CASE
  71.       CASE value0 > 1.0
  72.          ? "ILLEGAL ARCSIN ARGUMENT"
  73.          CANCEL
  74.       CASE value0 = 1.0
  75.          argument = value1 * 0.5 * 3.14159265358979
  76.       OTHERWISE
  77.          argument = argument / SQRT( 1.0 - argument * argument )
  78.          DO Arctan WITH argument
  79.    ENDCASE
  80. RETURN
  81. *
  82. *
  83. PROCEDURE Arccos  { Arccos function }
  84. PARAMETER argument
  85.    *  IN:  argument = ratio of sides
  86.    * OUT:  argument = ARCCOS( argument )
  87.    DO Arcsin WITH argument
  88.    argument = 0.5 * 3.14159265358979 - argument
  89. RETURN
  90. *
  91. *
  92. PROCEDURE Arctan  { Arctangent function }
  93. PARAMETER argument
  94.    * --- IN:  argument = ratio of sides
  95.    * ---OUT:  argument = angle in degrees
  96.    value0 = argument
  97.    IF value0 < 0.0
  98.       value0 = -(value0)
  99.    ENDIF
  100.    DO CASE
  101.       CASE value0 > 2.4142135623731
  102.          value3 = 2
  103.          value0 = -1.0 / value0
  104.       CASE value0 > .41421356237310
  105.          value3 = 1
  106.          value0 = 1.0 - ( 2.0 / ( 1.0 + value0 ) )
  107.       OTHERWISE
  108.          value3 = 0
  109.    ENDCASE
  110.    value1 = 216.06230789724
  111.    value2 = value0 * value0
  112.    value4 = ( ( ( 12.888383034157 * value2 + 132.70239816398 ) *;
  113.             value2 + 322.66207001325 ) * value2 + value1 ) * value0 
  114.    value5 = ( ( ( value2 + 38.501486508351 ) * value2 +;
  115.             221.05088302842 ) * value2 + 394.68283931228 ) *;
  116.             value2 + value1
  117.    value0 = value4 / value5
  118.    DO CASE
  119.       CASE value3 = 1 
  120.          value0 = value0 + .78539816339745
  121.       CASE value3 = 2
  122.          value0 = value0 + 1.5707963267949
  123.    ENDCASE
  124.    IF argument < 0.0
  125.       value0 = -(value0)
  126.    ENDIF
  127.    argument = value0
  128. RETURN
  129. *
  130. *
  131. PROCEDURE Tan_half  { Routine common to trig functions }
  132. PARAMETER argument
  133.    * --- IN:  argument in radians
  134.    * ---OUT:  argument = scaled argument
  135.    value0 = argument
  136.    IF argument < 0.0
  137.       argument = -(argument)
  138.    ENDIF
  139.    argument = argument / 6.2831853071795
  140.    argument = ( argument - INT( argument ) ) * 8.0
  141.    value2 = 0
  142.    DO WHILE argument >= 1.0
  143.       argument = 0.5 * argument
  144.       value2 = value2 + 1
  145.    ENDDO
  146.    value1 = argument * argument
  147.    value3 = ( value1 * .026247864594320 ) - 17.805646714386
  148.    value4 = ( ( value3 * value1 ) + 1038.5171455198 ) * argument
  149.    value5 = ( ( value1 - 181.2832834854 ) * value1 ) + 2644.5621951222
  150.    argument = value4 / value5 
  151.    DO WHILE value2 > 0
  152.       argument = (argument + argument) / (1.0 - (argument * argument))
  153.       value2 = value2 - 1
  154.    ENDDO
  155.    IF value0 < 0.0
  156.       argument = -(argument)
  157.    ENDIF
  158. RETURN
  159. *
  160. * EOF: TRIG.PRG
  161.